home *** CD-ROM | disk | FTP | other *** search
/ Professional Soft Collection 1.02 / Professional Soft Collection 1.02.iso / msdos622.rus / msdos_4.ddi / MONEY.BAS < prev    next >
BASIC Source File  |  1993-05-31  |  46KB  |  1,537 lines
  1. '
  2. '                    Q B a s i c   M O N E Y   M A N A G E R
  3. '
  4. '                   Copyright (C) Microsoft Corporation 1990
  5. '
  6. ' The Money Manager is a personal finance manager that allows you
  7. ' to enter account transactions while tracking your account balances
  8. ' and net worth.
  9. '
  10. ' To run this program, press Shift+F5.
  11. '
  12. ' To exit QBasic, press Alt, F, X.
  13. '
  14. ' To get help on a BASIC keyword, move the cursor to the keyword and press
  15. ' F1 or click the right mouse button.
  16. '
  17.  
  18.  
  19. 'Set default data type to integer for faster operation
  20. DEFINT A-Z
  21.  
  22. 'Sub and function declarations
  23. DECLARE SUB TransactionSummary (item%)
  24. DECLARE SUB LCenter (text$)
  25. DECLARE SUB ScrollUp ()
  26. DECLARE SUB ScrollDown ()
  27. DECLARE SUB Initialize ()
  28. DECLARE SUB Intro ()
  29. DECLARE SUB SparklePause ()
  30. DECLARE SUB Center (row%, text$)
  31. DECLARE SUB FancyCls (dots%, Background%)
  32. DECLARE SUB LoadState ()
  33. DECLARE SUB SaveState ()
  34. DECLARE SUB MenuSystem ()
  35. DECLARE SUB MakeBackup ()
  36. DECLARE SUB RestoreBackup ()
  37. DECLARE SUB Box (Row1%, Col1%, Row2%, Col2%)
  38. DECLARE SUB NetWorthReport ()
  39. DECLARE SUB EditAccounts ()
  40. DECLARE SUB PrintHelpLine (help$)
  41. DECLARE SUB EditTrans (item%)
  42. DECLARE FUNCTION Cvdt$ (X#)
  43. DECLARE FUNCTION Cvst$ (X!)
  44. DECLARE FUNCTION Cvit$ (X%)
  45. DECLARE FUNCTION Menu% (CurrChoiceX%, MaxChoice%, choice$(), ItemRow%(), ItemCol%(), help$(), BarMode%)
  46. DECLARE FUNCTION GetString$ (row%, col%, start$, end$, Vis%, Max%)
  47. DECLARE FUNCTION Trim$ (X$)
  48.  
  49. 'Constants
  50. CONST TRUE = -1
  51. CONST FALSE = NOT TRUE
  52.  
  53. 'User-defined types
  54. TYPE AccountType
  55.     Title        AS STRING * 20
  56.     AType        AS STRING * 1
  57.     Desc         AS STRING * 50
  58. END TYPE
  59.  
  60. TYPE Recordtype
  61.     Date     AS STRING * 8
  62.     Ref      AS STRING * 10
  63.     Desc     AS STRING * 50
  64.     Fig1     AS DOUBLE
  65.     Fig2     AS DOUBLE
  66. END TYPE
  67.  
  68. 'Global variables
  69. DIM SHARED account(1 TO 19)  AS AccountType     'Stores the 19 account titles
  70. DIM SHARED ColorPref                            'Color Preference
  71. DIM SHARED colors(0 TO 20, 1 TO 4)              'Different Colors
  72. DIM SHARED ScrollUpAsm(1 TO 7)                  'Assembly Language Routines
  73. DIM SHARED ScrollDownAsm(1 TO 7)
  74. DIM SHARED PrintErr AS INTEGER                  'Printer error flag
  75.  
  76.     DEF SEG = 0                     ' Turn off CapLock, NumLock and ScrollLock
  77.     KeyFlags = PEEK(1047)
  78.     POKE 1047, &H0
  79.     DEF SEG
  80.   
  81.     'Open money manager data file.  If it does not exist in current directory,
  82.     '  goto error handler to create and initialize it.
  83.     ON ERROR GOTO ErrorTrap
  84.     OPEN "money.dat" FOR INPUT AS #1
  85.     CLOSE
  86.     ON ERROR GOTO 0     'Reset error handler
  87.  
  88.     Initialize          'Initialize program
  89.     Intro               'Display introduction screen
  90.     MenuSystem          'This is the main program
  91.     COLOR 7, 0          'Clear screen and end
  92.     CLS
  93.  
  94.     DEF SEG = 0                     ' Restore CapLock, NumLock and ScrollLock states
  95.     POKE 1047, KeyFlags
  96.     DEF SEG
  97.  
  98.     END
  99.  
  100. ' Error handler for program
  101. ' If data file not found, create and initialize a new one.
  102. ErrorTrap:
  103.     SELECT CASE ERR
  104.         ' If data file not found, create and initialize a new one.
  105.         CASE 53
  106.             CLOSE
  107.             ColorPref = 1
  108.             FOR a = 1 TO 19
  109.                 account(a).Title = ""
  110.                 account(a).AType = ""
  111.                 account(a).Desc = ""
  112.             NEXT a
  113.             SaveState
  114.             RESUME
  115.         CASE 24, 25
  116.             PrintErr = TRUE
  117.             Box 8, 13, 14, 69
  118.             Center 11, "Printer not responding ... Press Space to continue"
  119.             WHILE INKEY$ <> "": WEND
  120.             WHILE INKEY$ <> " ": WEND
  121.             RESUME NEXT
  122.         CASE ELSE
  123.     END SELECT
  124.     RESUME NEXT
  125.  
  126.  
  127. 'The following data defines the color schemes available via the main menu.
  128. '
  129. '    scrn  dots  bar  back   title  shdow  choice  curs   cursbk  shdow
  130. DATA 0,    7,    15,  7,     0,     7,     0,      15,    0,      0
  131. DATA 1,    9,    12,  3,     0,     1,     15,     0,     7,      0
  132. DATA 3,    15,   13,  1,     14,    3,     15,     0,     7,      0
  133. DATA 7,    12,   15,  4,     14,    0,     15,     15,    1,      0
  134.  
  135. 'The following data is actually a machine language program to
  136. 'scroll the screen up or down very fast using a BIOS call.
  137. DATA &HB8,&H01,&H06,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB
  138. DATA &HB8,&H01,&H07,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB
  139.  
  140. 'Box:
  141. '  Draw a box on the screen between the given coordinates.
  142. SUB Box (Row1, Col1, Row2, Col2) STATIC
  143.  
  144.     BoxWidth = Col2 - Col1 + 1
  145.  
  146.     LOCATE Row1, Col1
  147.     PRINT "┌"; STRING$(BoxWidth - 2, "─"); "┐";
  148.  
  149.     FOR a = Row1 + 1 TO Row2 - 1
  150.         LOCATE a, Col1
  151.         PRINT "│"; SPACE$(BoxWidth - 2); "│";
  152.     NEXT a
  153.  
  154.     LOCATE Row2, Col1
  155.     PRINT "└"; STRING$(BoxWidth - 2, "─"); "┘";
  156.  
  157. END SUB
  158.  
  159. 'Center:
  160. '  Center text on the given row.
  161. SUB Center (row, text$)
  162.     LOCATE row, 41 - LEN(text$) / 2
  163.     PRINT text$;
  164. END SUB
  165.  
  166. 'Cvdt$:
  167. '  Convert a double precision number to a string WITHOUT a leading space.
  168. FUNCTION Cvdt$ (X#)
  169.  
  170.     Cvdt$ = RIGHT$(STR$(X#), LEN(STR$(X#)) - 1)
  171.  
  172. END FUNCTION
  173.  
  174. 'Cvit$:
  175. '  Convert an integer to a string WITHOUT a leading space.
  176. FUNCTION Cvit$ (X)
  177.     Cvit$ = RIGHT$(STR$(X), LEN(STR$(X)) - 1)
  178. END FUNCTION
  179.  
  180. 'Cvst$:
  181. '  Convert a single precision number to a string WITHOUT a leading space
  182. FUNCTION Cvst$ (X!)
  183.     Cvst$ = RIGHT$(STR$(X!), LEN(STR$(X!)) - 1)
  184. END FUNCTION
  185.  
  186. 'EditAccounts:
  187. '  This is the full-screen editor which allows you to change your account
  188. '  titles and descriptions
  189. SUB EditAccounts
  190.  
  191.     'Information about each column
  192.     REDIM help$(4), col(4), Vis(4), Max(4), edit$(19, 3)
  193.  
  194.     'Draw the screen
  195.     COLOR colors(7, ColorPref), colors(4, ColorPref)
  196.     Box 2, 1, 24, 80
  197.  
  198.     COLOR colors(5, ColorPref), colors(4, ColorPref)
  199.     LOCATE 1, 1: PRINT SPACE$(80)
  200.     LOCATE 1, 4: PRINT "Account Editor";
  201.     COLOR colors(7, ColorPref), colors(4, ColorPref)
  202.  
  203.     LOCATE 3, 2: PRINT "No│ Account Title      │ Description                                      │A/L"
  204.     LOCATE 4, 2: PRINT "──┼────────────────────┼──────────────────────────────────────────────────┼───"
  205.                   u$ = "##│\                  \│\                                                \│ ! "
  206.     FOR a = 5 TO 23
  207.         LOCATE a, 2
  208.         X = a - 4
  209.         PRINT USING u$; X; account(X).Title; account(X).Desc; account(X).AType;
  210.     NEXT a
  211.  
  212.     'Initialize variables
  213.     help$(1) = "  Account name                             | <F2=Save and Exit> <Escape=Abort>"
  214.     help$(2) = "  Account description                      | <F2=Save and Exit> <Escape=Abort>"
  215.     help$(3) = "  Account type (A = Asset, L = Liability)  | <F2=Save and Exit> <Escape=Abort>"
  216.                         
  217.     col(1) = 5: col(2) = 26: col(3) = 78
  218.     Vis(1) = 20: Vis(2) = 50: Vis(3) = 1
  219.     Max(1) = 20: Max(2) = 50: Max(3) = 1
  220.  
  221.     FOR a = 1 TO 19
  222.         edit$(a, 1) = account(a).Title
  223.         edit$(a, 2) = account(a).Desc
  224.         edit$(a, 3) = account(a).AType
  225.     NEXT a
  226.  
  227.     finished = FALSE
  228.  
  229.     CurrRow = 1
  230.     CurrCol = 1
  231.     PrintHelpLine help$(CurrCol)
  232.  
  233.     'Loop until F2 or <ESC> is pressed
  234.     DO
  235.         GOSUB EditAccountsShowCursor            'Show Cursor
  236.         DO                                      'Wait for key
  237.             Kbd$ = INKEY$
  238.         LOOP UNTIL Kbd$ <> ""
  239.  
  240.         IF Kbd$ >= " " AND Kbd$ < "~" THEN      'If legal, edit item
  241.             GOSUB EditAccountsEditItem
  242.         END IF
  243.         GOSUB EditAccountsHideCursor            'Hide Cursor so it can move
  244.                                                 'If it needs to
  245.         SELECT CASE Kbd$
  246.             CASE CHR$(0) + "H"                              'Up Arrow
  247.                 CurrRow = (CurrRow + 17) MOD 19 + 1
  248.             CASE CHR$(0) + "P"                              'Down Arrow
  249.                 CurrRow = (CurrRow) MOD 19 + 1
  250.             CASE CHR$(0) + "K", CHR$(0) + CHR$(15)          'Left or Shift+Tab
  251.                 CurrCol = (CurrCol + 1) MOD 3 + 1
  252.                 PrintHelpLine help$(CurrCol)
  253.             CASE CHR$(0) + "M", CHR$(9)                     'Right or Tab
  254.                 CurrCol = (CurrCol) MOD 3 + 1
  255.                 PrintHelpLine help$(CurrCol)
  256.             CASE CHR$(0) + "<"                              'F2
  257.                 finished = TRUE
  258.                 Save = TRUE
  259.             CASE CHR$(27)                                   'Esc
  260.                 finished = TRUE
  261.                 Save = FALSE
  262.             CASE CHR$(13)                                   'Return
  263.             CASE ELSE
  264.                 BEEP
  265.         END SELECT
  266.     LOOP UNTIL finished
  267.  
  268.     IF Save THEN
  269.         GOSUB EditAccountsSaveData
  270.     END IF
  271.  
  272.     EXIT SUB
  273.  
  274. EditAccountsShowCursor:
  275.     COLOR colors(8, ColorPref), colors(9, ColorPref)
  276.     LOCATE CurrRow + 4, col(CurrCol)
  277.     PRINT LEFT$(edit$(CurrRow, CurrCol), Vis(CurrCol));
  278.     RETURN
  279.  
  280. EditAccountsEditItem:
  281.     COLOR colors(8, ColorPref), colors(9, ColorPref)
  282.     ok = FALSE
  283.     start$ = Kbd$
  284.     DO
  285.         Kbd$ = GetString$(CurrRow + 4, col(CurrCol), start$, end$, Vis(CurrCol), Max(CurrCol))
  286.         edit$(CurrRow, CurrCol) = LEFT$(end$ + SPACE$(Max(CurrCol)), Max(CurrCol))
  287.         start$ = ""
  288.  
  289.         IF CurrCol = 3 THEN
  290.             X$ = UCASE$(end$)
  291.             IF X$ = "A" OR X$ = "L" OR X$ = "" OR X$ = " " THEN
  292.                 ok = TRUE
  293.                 IF X$ = "" THEN X$ = " "
  294.                 edit$(CurrRow, CurrCol) = X$
  295.             ELSE
  296.                 BEEP
  297.             END IF
  298.         ELSE
  299.             ok = TRUE
  300.         END IF
  301.         
  302.     LOOP UNTIL ok
  303.     RETURN
  304.  
  305. EditAccountsHideCursor:
  306.     COLOR colors(7, ColorPref), colors(4, ColorPref)
  307.     LOCATE CurrRow + 4, col(CurrCol)
  308.     PRINT LEFT$(edit$(CurrRow, CurrCol), Vis(CurrCol));
  309.     RETURN
  310.  
  311.  
  312. EditAccountsSaveData:
  313.     FOR a = 1 TO 19
  314.         account(a).Title = edit$(a, 1)
  315.         account(a).Desc = edit$(a, 2)
  316.         account(a).AType = edit$(a, 3)
  317.     NEXT a
  318.     SaveState
  319.     RETURN
  320.  
  321. END SUB
  322.  
  323. 'EditTrans:
  324. '  This is the full-screen editor which allows you to enter and change
  325. '  transactions
  326. SUB EditTrans (item)
  327.  
  328.     'Stores info about each column
  329.     REDIM help$(6), col(6), Vis(6), Max(6), CurrString$(3), CurrFig#(5)
  330.     'Array to keep the current balance at all the transactions
  331.     REDIM Balance#(1000)
  332.  
  333.     'Open random access file
  334.     file$ = "money." + Cvit$(item)
  335.     OPEN file$ FOR RANDOM AS #1 LEN = 84
  336.     FIELD #1, 8 AS IoDate$, 10 AS IoRef$, 50 AS IoDesc$, 8 AS IoFig1$, 8 AS IoFig2$
  337.     FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$
  338.  
  339.     'Initialize variables
  340.     CurrString$(1) = ""
  341.     CurrString$(2) = ""
  342.     CurrString$(3) = ""
  343.     CurrFig#(4) = 0
  344.     CurrFig#(5) = 0
  345.  
  346.     GET #1, 1
  347.     IF valid$ <> "THISISVALID" THEN
  348.         LSET IoDate$ = ""
  349.         LSET IoRef$ = ""
  350.         LSET IoDesc$ = ""
  351.         LSET IoFig1$ = MKD$(0)
  352.         LSET IoFig2$ = MKD$(0)
  353.         PUT #1, 2
  354.         LSET valid$ = "THISISVALID"
  355.         LSET IoMaxRecord$ = "1"
  356.         LSET IoBalance$ = MKD$(0)
  357.         PUT #1, 1
  358.     END IF
  359.  
  360.     MaxRecord = VAL(IoMaxRecord$)
  361.  
  362.     Balance#(0) = 0
  363.     a = 1
  364.     WHILE a <= MaxRecord
  365.         GET #1, a + 1
  366.         Balance#(a) = Balance#(a - 1) + CVD(IoFig1$) - CVD(IoFig2$)
  367.         a = a + 1
  368.     WEND
  369.     GOSUB EditTransWriteBalance
  370.  
  371.     help$(1) = "Date of transaction (mm/dd/yy) "
  372.     help$(2) = "Transaction reference number   "
  373.     help$(3) = "Transaction description        "
  374.     help$(4) = "Increase asset or debt value   "
  375.     help$(5) = "Decrease asset or debt value   "
  376.  
  377.     col(1) = 2
  378.     col(2) = 11
  379.     col(3) = 18
  380.     col(4) = 44
  381.     col(5) = 55
  382.  
  383.     Vis(1) = 8
  384.     Vis(2) = 6
  385.     Vis(3) = 25
  386.     Vis(4) = 10
  387.     Vis(5) = 10
  388.  
  389.     Max(1) = 8
  390.     Max(2) = 6
  391.     Max(3) = 25
  392.     Max(4) = 10
  393.     Max(5) = 10
  394.  
  395.  
  396.     'Draw Screen
  397.     COLOR colors(7, ColorPref), colors(4, ColorPref)
  398.     Box 2, 1, 24, 80
  399.  
  400.     COLOR colors(5, ColorPref), colors(4, ColorPref)
  401.     LOCATE 1, 1: PRINT SPACE$(80);
  402.     LOCATE 1, 4: PRINT "Transaction Editor: " + Trim$(account(item).Title);
  403.  
  404.     COLOR colors(7, ColorPref), colors(4, ColorPref)
  405.     LOCATE 3, 2: PRINT "  Date  │ Ref# │ Description             │ Increase │ Decrease │   Balance    "
  406.     LOCATE 4, 2: PRINT "────────┼──────┼─────────────────────────┼──────────┼──────────┼──────────────"
  407.  
  408.      u$ = "\      \│\    \│\                       \│"
  409.     u1$ = "        │      │                         │          │          │              "
  410.     u1x$ = "▀▀▀▀▀▀▀▀│▀▀▀▀▀▀│▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀│▀▀▀▀▀▀▀▀▀▀│▀▀▀▀▀▀▀▀▀▀│▀▀▀▀▀▀▀▀▀▀▀▀▀▀"
  411.     u2$ = "###,###.##"
  412.     u3$ = "###,###,###.##"
  413.     u4$ = "          "
  414.  
  415.     CurrTopline = 1
  416.     GOSUB EditTransPrintWholeScreen
  417.  
  418.     CurrRow = 1
  419.     CurrCol = 1
  420.     PrintHelpLine help$(CurrCol) + "|  <F2=Save and Exit> <F9=Insert> <F10=Delete>"
  421.  
  422.     GOSUB EditTransGetLine
  423.  
  424.     finished = FALSE
  425.  
  426.  
  427.     'Loop until <F2> is pressed
  428.     DO
  429.         GOSUB EditTransShowCursor                   'Show Cursor, Wait for key
  430.         DO: Kbd$ = INKEY$: LOOP UNTIL Kbd$ <> ""
  431.         GOSUB EditTransHideCursor
  432.  
  433.         IF Kbd$ >= " " AND Kbd$ < "~" OR Kbd$ = CHR$(8) THEN        'If legal key, edit item
  434.             GOSUB EditTransEditItem
  435.         END IF
  436.  
  437.         SELECT CASE Kbd$                            'Handle Special keys
  438.             CASE CHR$(0) + "H"                      'up arrow
  439.                 GOSUB EditTransMoveUp
  440.             CASE CHR$(0) + "P"                      'Down arrow
  441.                 GOSUB EditTransMoveDown
  442.             CASE CHR$(0) + "K", CHR$(0) + CHR$(15)  'Left Arrow,BackTab
  443.                 CurrCol = (CurrCol + 3) MOD 5 + 1
  444.                 PrintHelpLine help$(CurrCol) + "|  <F2=Save and Exit> <F9=Insert> <F10=Delete>"
  445.             CASE CHR$(0) + "M", CHR$(9)             'Right Arrow,Tab
  446.                 CurrCol = (CurrCol) MOD 5 + 1
  447.                 PrintHelpLine help$(CurrCol) + "|  <F2=Save and Exit> <F9=Insert> <F10=Delete>"
  448.             CASE CHR$(0) + "G"                      'Home
  449.                 CurrCol = 1
  450.             CASE CHR$(0) + "O"                      'End
  451.                 CurrCol = 5
  452.             CASE CHR$(0) + "I"                      'Page Up
  453.                 CurrRow = 1
  454.                 CurrTopline = CurrTopline - 19
  455.                 IF CurrTopline < 1 THEN
  456.                     CurrTopline = 1
  457.                 END IF
  458.                 GOSUB EditTransPrintWholeScreen
  459.                 GOSUB EditTransGetLine
  460.             CASE CHR$(0) + "Q"                      'Page Down
  461.                 CurrRow = 1
  462.                 CurrTopline = CurrTopline + 19
  463.                 IF CurrTopline > MaxRecord THEN
  464.                     CurrTopline = MaxRecord
  465.                 END IF
  466.                 GOSUB EditTransPrintWholeScreen
  467.                 GOSUB EditTransGetLine
  468.             CASE CHR$(0) + "<"                      'F2
  469.                 finished = TRUE
  470.             CASE CHR$(0) + "C"                      'F9
  471.                 GOSUB EditTransAddRecord
  472.             CASE CHR$(0) + "D"                      'F10
  473.                 GOSUB EditTransDeleteRecord
  474.             CASE CHR$(13)                           'Enter
  475.             CASE ELSE
  476.                BEEP
  477.         END SELECT
  478.     LOOP UNTIL finished
  479.  
  480.     CLOSE
  481.  
  482.     EXIT SUB
  483.  
  484.  
  485. EditTransShowCursor:
  486.     COLOR colors(8, ColorPref), colors(9, ColorPref)
  487.     LOCATE CurrRow + 4, col(CurrCol)
  488.     SELECT CASE CurrCol
  489.         CASE 1, 2, 3
  490.             PRINT LEFT$(CurrString$(CurrCol), Vis(CurrCol));
  491.         CASE 4
  492.             IF CurrFig#(4) <> 0 THEN
  493.                 PRINT USING u2$; CurrFig#(4);
  494.             ELSE
  495.                 PRINT SPACE$(Vis(CurrCol));
  496.             END IF
  497.         CASE 5
  498.             IF CurrFig#(5) <> 0 THEN
  499.                 PRINT USING u2$; CurrFig#(5);
  500.             ELSE
  501.                 PRINT SPACE$(Vis(CurrCol));
  502.             END IF
  503.     END SELECT
  504.     RETURN
  505.  
  506.  
  507. EditTransHideCursor:
  508.     COLOR colors(7, ColorPref), colors(4, ColorPref)
  509.     LOCATE CurrRow + 4, col(CurrCol)
  510.     SELECT CASE CurrCol
  511.         CASE 1, 2, 3
  512.             PRINT LEFT$(CurrString$(CurrCol), Vis(CurrCol));
  513.         CASE 4
  514.             IF CurrFig#(4) <> 0 THEN
  515.                 PRINT USING u2$; CurrFig#(4);
  516.             ELSE
  517.                 PRINT SPACE$(Vis(CurrCol));
  518.             END IF
  519.         CASE 5
  520.             IF CurrFig#(5) <> 0 THEN
  521.                 PRINT USING u2$; CurrFig#(5);
  522.             ELSE
  523.                 PRINT SPACE$(Vis(CurrCol));
  524.             END IF
  525.     END SELECT
  526.     RETURN
  527.  
  528.  
  529. EditTransEditItem:
  530.  
  531.     CurrRecord = CurrTopline + CurrRow - 1
  532.     COLOR colors(8, ColorPref), colors(9, ColorPref)
  533.  
  534.     SELECT CASE CurrCol
  535.         CASE 1, 2, 3
  536.             Kbd$ = GetString$(CurrRow + 4, col(CurrCol), Kbd$, new$, Vis(CurrCol), Max(CurrCol))
  537.             CurrString$(CurrCol) = new$
  538.             GOSUB EditTransPutLine
  539.             GOSUB EditTransGetLine
  540.         CASE 4
  541.             start$ = Kbd$
  542.             DO
  543.                 Kbd$ = GetString$(CurrRow + 4, col(4), start$, new$, Vis(4), Max(4))
  544.                 new4# = VAL(new$)
  545.                 start$ = ""
  546.             LOOP WHILE new4# >= 999999.99# OR new4# < 0
  547.  
  548.             a = CurrRecord
  549.             WHILE a <= MaxRecord
  550.                 Balance#(a) = Balance#(a) + new4# - CurrFig#(4) + CurrFig#(5)
  551.                 a = a + 1
  552.             WEND
  553.             CurrFig#(4) = new4#
  554.             CurrFig#(5) = 0
  555.             GOSUB EditTransPutLine
  556.             GOSUB EditTransGetLine
  557.             GOSUB EditTransPrintBalances
  558.             GOSUB EditTransWriteBalance
  559.         CASE 5
  560.             start$ = Kbd$
  561.             DO
  562.                 Kbd$ = GetString$(CurrRow + 4, col(5), start$, new$, Vis(5), Max(5))
  563.                 new5# = VAL(new$)
  564.                 start$ = ""
  565.             LOOP WHILE new5# >= 999999.99# OR new5# < 0
  566.  
  567.             a = CurrRecord
  568.             WHILE a <= MaxRecord
  569.                 Balance#(a) = Balance#(a) - new5# + CurrFig#(5) - CurrFig#(4)
  570.                 a = a + 1
  571.             WEND
  572.             CurrFig#(4) = 0
  573.             CurrFig#(5) = new5#
  574.             GOSUB EditTransPutLine
  575.             GOSUB EditTransGetLine
  576.             GOSUB EditTransPrintBalances
  577.             GOSUB EditTransWriteBalance
  578.         CASE ELSE
  579.     END SELECT
  580.     GOSUB EditTransPrintLine
  581.     RETURN
  582.  
  583. EditTransMoveUp:
  584.     IF CurrRow = 1 THEN
  585.         IF CurrTopline = 1 THEN
  586.             BEEP
  587.         ELSE
  588.             ScrollDown
  589.             CurrTopline = CurrTopline - 1
  590.             GOSUB EditTransGetLine
  591.             GOSUB EditTransPrintLine
  592.         END IF
  593.     ELSE
  594.         CurrRow = CurrRow - 1
  595.         GOSUB EditTransGetLine
  596.     END IF
  597.     RETURN
  598.  
  599. EditTransMoveDown:
  600.     IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN
  601.         BEEP
  602.     ELSE
  603.         IF CurrRow = 19 THEN
  604.             ScrollUp
  605.             CurrTopline = CurrTopline + 1
  606.             GOSUB EditTransGetLine
  607.             GOSUB EditTransPrintLine
  608.         ELSE
  609.             CurrRow = CurrRow + 1
  610.             GOSUB EditTransGetLine
  611.         END IF
  612.     END IF
  613.     RETURN
  614.  
  615. EditTransPrintLine:
  616.     COLOR colors(7, ColorPref), colors(4, ColorPref)
  617.     CurrRecord = CurrTopline + CurrRow - 1
  618.     LOCATE CurrRow + 4, 2
  619.     IF CurrRecord = MaxRecord + 1 THEN
  620.         PRINT u1x$;
  621.     ELSEIF CurrRecord > MaxRecord THEN
  622.         PRINT u1$;
  623.     ELSE
  624.         PRINT USING u$; CurrString$(1); CurrString$(2); CurrString$(3);
  625.         IF CurrFig#(4) = 0 AND CurrFig#(5) = 0 THEN
  626.             PRINT USING u4$ + "│" + u4$ + "│" + u3$; Balance#(CurrRecord)
  627.         ELSEIF CurrFig#(5) = 0 THEN
  628.             PRINT USING u2$ + "│" + u4$ + "│" + u3$; CurrFig#(4); Balance#(CurrRecord)
  629.         ELSE
  630.             PRINT USING u4$ + "│" + u2$ + "│" + u3$; CurrFig#(5); Balance#(CurrRecord)
  631.         END IF
  632.     END IF
  633.     RETURN
  634.  
  635. EditTransPrintBalances:
  636.     COLOR colors(7, ColorPref), colors(4, ColorPref)
  637.     FOR a = 1 TO 19
  638.         CurrRecord = CurrTopline + a - 1
  639.         IF CurrRecord <= MaxRecord THEN
  640.             LOCATE 4 + a, 66
  641.             PRINT USING u3$; Balance#(CurrTopline + a - 1);
  642.         END IF
  643.     NEXT a
  644.     RETURN
  645.  
  646. EditTransDeleteRecord:
  647.     IF MaxRecord = 1 THEN
  648.         BEEP
  649.     ELSE
  650.         CurrRecord = CurrTopline + CurrRow - 1
  651.         MaxRecord = MaxRecord - 1
  652.         a = CurrRecord
  653.         WHILE a <= MaxRecord
  654.             GET #1, a + 2
  655.             PUT #1, a + 1
  656.             Balance#(a) = Balance#(a + 1) - CurrFig#(4) + CurrFig#(5)
  657.             a = a + 1
  658.         WEND
  659.         
  660.         LSET valid$ = "THISISVALID"
  661.         LSET IoMaxRecord$ = Cvit$(MaxRecord)
  662.         PUT #1, 1
  663.         GOSUB EditTransPrintWholeScreen
  664.         CurrRecord = CurrTopline + CurrRow - 1
  665.         IF CurrRecord > MaxRecord THEN
  666.             GOSUB EditTransMoveUp
  667.         END IF
  668.         GOSUB EditTransGetLine
  669.         GOSUB EditTransWriteBalance
  670.     END IF
  671.     RETURN
  672.  
  673. EditTransAddRecord:
  674.     CurrRecord = CurrTopline + CurrRow - 1
  675.     a = MaxRecord
  676.     WHILE a > CurrRecord
  677.         GET #1, a + 1
  678.         PUT #1, a + 2
  679.         Balance#(a + 1) = Balance#(a)
  680.         a = a - 1
  681.     WEND
  682.     Balance#(CurrRecord + 1) = Balance#(CurrRecord)
  683.     MaxRecord = MaxRecord + 1
  684.     LSET IoDate$ = ""
  685.     LSET IoRef$ = ""
  686.     LSET IoDesc$ = ""
  687.     LSET IoFig1$ = MKD$(0)
  688.     LSET IoFig2$ = MKD$(0)
  689.     PUT #1, CurrRecord + 2
  690.  
  691.     LSET valid$ = "THISISVALID"
  692.     LSET IoMaxRecord$ = Cvit$(MaxRecord)
  693.     PUT #1, 1
  694.     GOSUB EditTransPrintWholeScreen
  695.     GOSUB EditTransGetLine
  696.     RETURN
  697.  
  698. EditTransPrintWholeScreen:
  699.     temp = CurrRow
  700.     FOR CurrRow = 1 TO 19
  701.         CurrRecord = CurrTopline + CurrRow - 1
  702.         IF CurrRecord <= MaxRecord THEN
  703.             GOSUB EditTransGetLine
  704.         END IF
  705.         GOSUB EditTransPrintLine
  706.     NEXT CurrRow
  707.     CurrRow = temp
  708.     RETURN
  709.  
  710. EditTransWriteBalance:
  711.     GET #1, 1
  712.     LSET IoBalance$ = MKD$(Balance#(MaxRecord))
  713.     PUT #1, 1
  714.     RETURN
  715.  
  716. EditTransPutLine:
  717.     CurrRecord = CurrTopline + CurrRow - 1
  718.     LSET IoDate$ = CurrString$(1)
  719.     LSET IoRef$ = CurrString$(2)
  720.     LSET IoDesc$ = CurrString$(3)
  721.     LSET IoFig1$ = MKD$(CurrFig#(4))
  722.     LSET IoFig2$ = MKD$(CurrFig#(5))
  723.     PUT #1, CurrRecord + 1
  724.     RETURN
  725.  
  726. EditTransGetLine:
  727.     CurrRecord = CurrTopline + CurrRow - 1
  728.     GET #1, CurrRecord + 1
  729.     CurrString$(1) = IoDate$
  730.     CurrString$(2) = IoRef$
  731.     CurrString$(3) = IoDesc$
  732.     CurrFig#(4) = CVD(IoFig1$)
  733.     CurrFig#(5) = CVD(IoFig2$)
  734.     RETURN
  735. END SUB
  736.  
  737. 'FancyCls:
  738. '  Clears screen in the right color, and draws nice dots.
  739. SUB FancyCls (dots, Background)
  740.  
  741.     VIEW PRINT 2 TO 24
  742.     COLOR dots, Background
  743.     CLS 2
  744.  
  745.     FOR a = 95 TO 1820 STEP 45
  746.         row = a / 80 + 1
  747.         col = a MOD 80 + 1
  748.         LOCATE row, col
  749.         PRINT CHR$(250);
  750.     NEXT a
  751.  
  752.     VIEW PRINT
  753.  
  754. END SUB
  755.  
  756. 'GetString$:
  757. '  Given a row and col, and an initial string, edit a string
  758. '  VIS is the length of the visible field of entry
  759. '  MAX is the maximum number of characters allowed in the string
  760. FUNCTION GetString$ (row, col, start$, end$, Vis, Max)
  761.     curr$ = Trim$(LEFT$(start$, Max))
  762.     IF curr$ = CHR$(8) THEN curr$ = ""
  763.  
  764.     LOCATE , , 1
  765.  
  766.     finished = FALSE
  767.     DO
  768.         GOSUB GetStringShowText
  769.         GOSUB GetStringGetKey
  770.  
  771.         IF LEN(Kbd$) > 1 THEN
  772.             finished = TRUE
  773.             GetString$ = Kbd$
  774.         ELSE
  775.             SELECT CASE Kbd$
  776.                 CASE CHR$(13), CHR$(27), CHR$(9)
  777.                     finished = TRUE
  778.                     GetString$ = Kbd$
  779.                 
  780.                 CASE CHR$(8)
  781.                     IF curr$ <> "" THEN
  782.                         curr$ = LEFT$(curr$, LEN(curr$) - 1)
  783.                     END IF
  784.  
  785.                 CASE " " TO "}"
  786.                     IF LEN(curr$) < Max THEN
  787.                         curr$ = curr$ + Kbd$
  788.                     ELSE
  789.                         BEEP
  790.                     END IF
  791.  
  792.                 CASE ELSE
  793.                     BEEP
  794.             END SELECT
  795.         END IF
  796.  
  797.     LOOP UNTIL finished
  798.  
  799.     end$ = curr$
  800.     LOCATE , , 0
  801.     EXIT FUNCTION
  802.     
  803.  
  804. GetStringShowText:
  805.     LOCATE row, col
  806.     IF LEN(curr$) > Vis THEN
  807.         PRINT RIGHT$(curr$, Vis);
  808.     ELSE
  809.         PRINT curr$; SPACE$(Vis - LEN(curr$));
  810.         LOCATE row, col + LEN(curr$)
  811.     END IF
  812.     RETURN
  813.  
  814. GetStringGetKey:
  815.     Kbd$ = ""
  816.     WHILE Kbd$ = ""
  817.         Kbd$ = INKEY$
  818.     WEND
  819.     RETURN
  820. END FUNCTION
  821.  
  822. 'Initialize:
  823. '  Read colors in and set up assembly routines
  824. SUB Initialize
  825.  
  826.     WIDTH , 25
  827.     VIEW PRINT
  828.  
  829.     FOR ColorSet = 1 TO 4
  830.         FOR X = 1 TO 10
  831.             READ colors(X, ColorSet)
  832.         NEXT X
  833.     NEXT ColorSet
  834.  
  835.     LoadState
  836.  
  837.     P = VARPTR(ScrollUpAsm(1))
  838.     DEF SEG = VARSEG(ScrollUpAsm(1))
  839.     FOR I = 0 TO 13
  840.        READ J
  841.        POKE (P + I), J
  842.     NEXT I
  843.  
  844.     P = VARPTR(ScrollDownAsm(1))
  845.     DEF SEG = VARSEG(ScrollDownAsm(1))
  846.     FOR I = 0 TO 13
  847.        READ J
  848.        POKE (P + I), J
  849.     NEXT I
  850.  
  851.     DEF SEG
  852.  
  853. END SUB
  854.  
  855. 'Intro:
  856. '  Display introduction screen.
  857. SUB Intro
  858.     SCREEN 0
  859.     WIDTH 80, 25
  860.     COLOR 7, 0
  861.     CLS
  862.  
  863.     Center 4, "Q B a s i c"
  864.     COLOR 15
  865.     Center 5, "▄     ▄ ▄▄▄▄ ▄   ▄ ▄▄▄▄ ▄   ▄      ▄     ▄ ▄▄▄▄ ▄   ▄ ▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄ ▄▄▄▄▄"
  866.     Center 6, "█▀▄ ▄▀█ █  █ █▄  █ █    █▄▄▄█      █▀▄ ▄▀█ █  █ █▄  █ █  █ █     █    █   █"
  867.     Center 7, "█  ▀  █ █  █ █ ▀▄█ █▀▀▀   █        █  ▀  █ █▀▀█ █ ▀▄█ █▀▀█ █ ▀▀█ █▀▀▀ █▀█▀▀"
  868.     Center 8, "█     █ █▄▄█ █   █ █▄▄▄   █        █     █ █  █ █   █ █  █ █▄▄▄█ █▄▄▄ █  ▀▄"
  869.     COLOR 7
  870.     Center 11, "A Personal Finance Manager written in"
  871.     Center 12, "MS-DOS QBasic"
  872.     Center 24, "Press any key to continue"
  873.  
  874.     SparklePause
  875. END SUB
  876.  
  877. 'LCenter:
  878. '  Center TEXT$ on the line printer
  879. SUB LCenter (text$)
  880.     LPRINT TAB(41 - LEN(text$) / 2); text$
  881. END SUB
  882.  
  883. 'LoadState:
  884. '  Load color preferences and account info from MONEY.DAT
  885. SUB LoadState
  886.  
  887.     OPEN "money.dat" FOR INPUT AS #1
  888.     INPUT #1, ColorPref
  889.  
  890.     FOR a = 1 TO 19
  891.         LINE INPUT #1, account(a).Title
  892.         LINE INPUT #1, account(a).AType
  893.         LINE INPUT #1, account(a).Desc
  894.     NEXT a
  895.     
  896.     CLOSE
  897.  
  898. END SUB
  899.  
  900. 'Menu:
  901. '  Handles Menu Selection for a single menu (either sub menu, or menu bar)
  902. '  currChoiceX  :  Number of current choice
  903. '  maxChoice    :  Number of choices in the list
  904. '  choice$()    :  Array with the text of the choices
  905. '  itemRow()    :  Array with the row of the choices
  906. '  itemCol()    :  Array with the col of the choices
  907. '  help$()      :  Array with the help text for each choice
  908. '  barMode      :  Boolean:  TRUE = menu bar style, FALSE = drop down style
  909. '
  910. '  Returns the number of the choice that was made by changing currChoiceX
  911. '  and returns the scan code of the key that was pressed to exit
  912. '
  913. FUNCTION Menu (CurrChoiceX, MaxChoice, choice$(), ItemRow(), ItemCol(), help$(), BarMode)
  914.    
  915.     currChoice = CurrChoiceX
  916.  
  917.     'if in bar mode, color in menu bar, else color box/shadow
  918.     'bar mode means you are currently in the menu bar, not a sub menu
  919.     IF BarMode THEN
  920.         COLOR colors(7, ColorPref), colors(4, ColorPref)
  921.         LOCATE 1, 1
  922.         PRINT SPACE$(80);
  923.     ELSE
  924.         FancyCls colors(2, ColorPref), colors(1, ColorPref)
  925.         COLOR colors(7, ColorPref), colors(4, ColorPref)
  926.         Box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(MaxChoice) + 1, ItemCol(1) + LEN(choice$(1)) + 1
  927.         
  928.         COLOR colors(10, ColorPref), colors(6, ColorPref)
  929.         FOR a = 1 TO MaxChoice + 1
  930.             LOCATE ItemRow(1) + a - 1, ItemCol(1) + LEN(choice$(1)) + 2
  931.             PRINT CHR$(178); CHR$(178);
  932.         NEXT a
  933.         LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 2
  934.         PRINT STRING$(LEN(choice$(MaxChoice)) + 2, 178);
  935.     END IF
  936.     
  937.     'print the choices
  938.     COLOR colors(7, ColorPref), colors(4, ColorPref)
  939.     FOR a = 1 TO MaxChoice
  940.         LOCATE ItemRow(a), ItemCol(a)
  941.         PRINT choice$(a);
  942.     NEXT a
  943.  
  944.     finished = FALSE
  945.  
  946.     WHILE NOT finished
  947.         
  948.         GOSUB MenuShowCursor
  949.         GOSUB MenuGetKey
  950.         GOSUB MenuHideCursor
  951.  
  952.         SELECT CASE Kbd$
  953.             CASE CHR$(0) + "H": GOSUB MenuUp
  954.             CASE CHR$(0) + "P": GOSUB MenuDown
  955.             CASE CHR$(0) + "K": GOSUB MenuLeft
  956.             CASE CHR$(0) + "M": GOSUB MenuRight
  957.             CASE CHR$(13): GOSUB MenuEnter
  958.             CASE CHR$(27): GOSUB MenuEscape
  959.             CASE ELSE:  BEEP
  960.         END SELECT
  961.     WEND
  962.  
  963.     Menu = currChoice
  964.  
  965.     EXIT FUNCTION
  966.  
  967.  
  968. MenuEnter:
  969.     finished = TRUE
  970.     RETURN
  971.  
  972. MenuEscape:
  973.     currChoice = 0
  974.     finished = TRUE
  975.     RETURN
  976.  
  977. MenuUp:
  978.     IF BarMode THEN
  979.         BEEP
  980.     ELSE
  981.         currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1
  982.     END IF
  983.     RETURN
  984.  
  985. MenuLeft:
  986.     IF BarMode THEN
  987.         currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1
  988.     ELSE
  989.         currChoice = -2
  990.         finished = TRUE
  991.     END IF
  992.     RETURN
  993.  
  994. MenuRight:
  995.     IF BarMode THEN
  996.         currChoice = (currChoice) MOD MaxChoice + 1
  997.     ELSE
  998.         currChoice = -3
  999.         finished = TRUE
  1000.     END IF
  1001.     RETURN
  1002.  
  1003. MenuDown:
  1004.     IF BarMode THEN
  1005.         finished = TRUE
  1006.     ELSE
  1007.         currChoice = (currChoice) MOD MaxChoice + 1
  1008.     END IF
  1009.     RETURN
  1010.  
  1011. MenuShowCursor:
  1012.     COLOR colors(8, ColorPref), colors(9, ColorPref)
  1013.     LOCATE ItemRow(currChoice), ItemCol(currChoice)
  1014.     PRINT choice$(currChoice);
  1015.     PrintHelpLine help$(currChoice)
  1016.     RETURN
  1017.  
  1018. MenuGetKey:
  1019.     Kbd$ = ""
  1020.     WHILE Kbd$ = ""
  1021.         Kbd$ = INKEY$
  1022.     WEND
  1023.     RETURN
  1024.  
  1025. MenuHideCursor:
  1026.     COLOR colors(7, ColorPref), colors(4, ColorPref)
  1027.     LOCATE ItemRow(currChoice), ItemCol(currChoice)
  1028.     PRINT choice$(currChoice);
  1029.     RETURN
  1030.  
  1031.  
  1032. END FUNCTION
  1033.  
  1034. 'MenuSystem:
  1035. '  Main routine that controls the program.  Uses the MENU function
  1036. '  to implement menu system and calls the appropriate function to handle
  1037. '  the user's selection
  1038. SUB MenuSystem
  1039.  
  1040.     DIM choice$(20), menuRow(20), menuCol(20), help$(20)
  1041.     LOCATE , , 0
  1042.     choice = 1
  1043.     finished = FALSE
  1044.  
  1045.     WHILE NOT finished
  1046.         GOSUB MenuSystemMain
  1047.  
  1048.         subchoice = -1
  1049.         WHILE subchoice < 0
  1050.             SELECT CASE choice
  1051.                 CASE 1: GOSUB MenuSystemFile
  1052.                 CASE 2: GOSUB MenuSystemEdit
  1053.                 CASE 3: GOSUB MenuSystemAccount
  1054.                 CASE 4: GOSUB MenuSystemReport
  1055.                 CASE 5: GOSUB MenuSystemColors
  1056.             END SELECT
  1057.             FancyCls colors(2, ColorPref), colors(1, ColorPref)
  1058.  
  1059.             SELECT CASE subchoice
  1060.                 CASE -2: choice = (choice + 3) MOD 5 + 1
  1061.                 CASE -3: choice = (choice) MOD 5 + 1
  1062.             END SELECT
  1063.         WEND
  1064.     WEND
  1065.     EXIT SUB
  1066.  
  1067.  
  1068. MenuSystemMain:
  1069.     FancyCls colors(2, ColorPref), colors(1, ColorPref)
  1070.     COLOR colors(7, ColorPref), colors(4, ColorPref)
  1071.     Box 9, 19, 14, 61
  1072.     Center 11, "Use arrow keys to navigate menu system"
  1073.     Center 12, "Press Enter to select a menu item"
  1074.  
  1075.     choice$(1) = " File "
  1076.     choice$(2) = " Accounts "
  1077.     choice$(3) = " Transactions "
  1078.     choice$(4) = " Reports "
  1079.     choice$(5) = " Colors "
  1080.  
  1081.     menuRow(1) = 1: menuCol(1) = 2
  1082.     menuRow(2) = 1: menuCol(2) = 8
  1083.     menuRow(3) = 1: menuCol(3) = 18
  1084.     menuRow(4) = 1: menuCol(4) = 32
  1085.     menuRow(5) = 1: menuCol(5) = 41
  1086.     
  1087.     help$(1) = "Exit the Money Manager"
  1088.     help$(2) = "Add/edit/delete accounts"
  1089.     help$(3) = "Add/edit/delete account transactions"
  1090.     help$(4) = "View and print reports"
  1091.     help$(5) = "Set screen colors"
  1092.     
  1093.     DO
  1094.         NewChoice = Menu((choice), 5, choice$(), menuRow(), menuCol(), help$(), TRUE)
  1095.     LOOP WHILE NewChoice = 0
  1096.     choice = NewChoice
  1097.     RETURN
  1098.  
  1099. MenuSystemFile:
  1100.     choice$(1) = " Exit           "
  1101.  
  1102.     menuRow(1) = 3: menuCol(1) = 2
  1103.  
  1104.     help$(1) = "Exit the Money Manager"
  1105.  
  1106.     subchoice = Menu(1, 1, choice$(), menuRow(), menuCol(), help$(), FALSE)
  1107.  
  1108.     SELECT CASE subchoice
  1109.         CASE 1: finished = TRUE
  1110.         CASE ELSE
  1111.     END SELECT
  1112.     RETURN
  1113.  
  1114.  
  1115. MenuSystemEdit:
  1116.     choice$(1) = " Edit Account Titles "
  1117.  
  1118.     menuRow(1) = 3: menuCol(1) = 8
  1119.     
  1120.     help$(1) = "Add/edit/delete accounts"
  1121.  
  1122.     subchoice = Menu(1, 1, choice$(), menuRow(), menuCol(), help$(), FALSE)
  1123.  
  1124.     SELECT CASE subchoice
  1125.         CASE 1: EditAccounts
  1126.         CASE ELSE
  1127.     END SELECT
  1128.     RETURN
  1129.  
  1130.  
  1131. MenuSystemAccount:
  1132.  
  1133.     FOR a = 1 TO 19
  1134.         IF Trim$(account(a).Title) = "" THEN
  1135.             choice$(a) = RIGHT$(STR$(a), 2) + ". ------------------- "
  1136.         ELSE
  1137.             choice$(a) = RIGHT$(STR$(a), 2) + ". " + account(a).Title
  1138.         END IF
  1139.         menuRow(a) = a + 2
  1140.         menuCol(a) = 19
  1141.         help$(a) = RTRIM$(account(a).Desc)
  1142.     NEXT a
  1143.  
  1144.     subchoice = Menu(1, 19, choice$(), menuRow(), menuCol(), help$(), FALSE)
  1145.  
  1146.     IF subchoice > 0 THEN
  1147.         EditTrans (subchoice)
  1148.     END IF
  1149.     RETURN
  1150.  
  1151.  
  1152. MenuSystemReport:
  1153.     choice$(1) = " Net Worth Report       "
  1154.     menuRow(1) = 3: menuCol(1) = 32
  1155.     help$(1) = "View and print net worth report"
  1156.  
  1157.     FOR a = 1 TO 19
  1158.         IF Trim$(account(a).Title) = "" THEN
  1159.             choice$(a + 1) = RIGHT$(STR$(a), 2) + ". ------------------- "
  1160.         ELSE
  1161.             choice$(a + 1) = RIGHT$(STR$(a), 2) + ". " + account(a).Title
  1162.         END IF
  1163.         menuRow(a + 1) = a + 3
  1164.         menuCol(a + 1) = 32
  1165.         help$(a + 1) = "Print " + RTRIM$(account(a).Title) + " transaction summary"
  1166.     NEXT a
  1167.  
  1168.     subchoice = Menu(1, 20, choice$(), menuRow(), menuCol(), help$(), FALSE)
  1169.  
  1170.     SELECT CASE subchoice
  1171.         CASE 1
  1172.             NetWorthReport
  1173.         CASE 2 TO 20
  1174.             TransactionSummary (subchoice - 1)
  1175.         CASE ELSE
  1176.     END SELECT
  1177.     RETURN
  1178.  
  1179. MenuSystemColors:
  1180.     choice$(1) = " Monochrome Scheme "
  1181.     choice$(2) = " Cyan/Blue Scheme  "
  1182.     choice$(3) = " Blue/Cyan Scheme  "
  1183.     choice$(4) = " Red/Grey Scheme   "
  1184.  
  1185.     menuRow(1) = 3: menuCol(1) = 41
  1186.     menuRow(2) = 4: menuCol(2) = 41
  1187.     menuRow(3) = 5: menuCol(3) = 41
  1188.     menuRow(4) = 6: menuCol(4) = 41
  1189.  
  1190.     help$(1) = "Color scheme for monochrome and LCD displays"
  1191.     help$(2) = "Color scheme featuring cyan"
  1192.     help$(3) = "Color scheme featuring blue"
  1193.     help$(4) = "Color scheme featuring red"
  1194.  
  1195.     subchoice = Menu(1, 4, choice$(), menuRow(), menuCol(), help$(), FALSE)
  1196.  
  1197.     SELECT CASE subchoice
  1198.         CASE 1 TO 4
  1199.             ColorPref = subchoice
  1200.             SaveState
  1201.         CASE ELSE
  1202.     END SELECT
  1203.     RETURN
  1204.  
  1205.  
  1206. END SUB
  1207.  
  1208. 'NetWorthReport:
  1209. '  Prints net worth report to screen and printer
  1210. SUB NetWorthReport
  1211.     DIM assetIndex(19), liabilityIndex(19)
  1212.  
  1213.     maxAsset = 0
  1214.     maxLiability = 0
  1215.  
  1216.     FOR a = 1 TO 19
  1217.         IF account(a).AType = "A" THEN
  1218.             maxAsset = maxAsset + 1
  1219.             assetIndex(maxAsset) = a
  1220.         ELSEIF account(a).AType = "L" THEN
  1221.             maxLiability = maxLiability + 1
  1222.             liabilityIndex(maxLiability) = a
  1223.         END IF
  1224.     NEXT a
  1225.  
  1226.     'Loop until <F2> is pressed
  1227.     finished = FALSE
  1228.     DO
  1229.         u1$ = "\                  \$$###,###,###.##"
  1230.         u2$ = "\               \+$$#,###,###,###.##"
  1231.  
  1232.         COLOR colors(5, ColorPref), colors(4, ColorPref)
  1233.         LOCATE 1, 1: PRINT SPACE$(80);
  1234.         LOCATE 1, 4: PRINT "Net Worth Report: " + DATE$;
  1235.         PrintHelpLine "<F2=Exit>    <F3=Print Report>"
  1236.  
  1237.         COLOR colors(7, ColorPref), colors(4, ColorPref)
  1238.         Box 2, 1, 24, 40
  1239.         Box 2, 41, 24, 80
  1240.  
  1241.         LOCATE 2, 16: PRINT " ASSETS "
  1242.         assetTotal# = 0
  1243.         a = 1
  1244.         count1 = 1
  1245.         WHILE a <= maxAsset
  1246.             file$ = "money." + Cvit$(assetIndex(a))
  1247.             OPEN file$ FOR RANDOM AS #1 LEN = 84
  1248.             FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$
  1249.             GET #1, 1
  1250.             IF valid$ = "THISISVALID" THEN
  1251.                 LOCATE 2 + count1, 3: PRINT USING u1$; account(assetIndex(a)).Title; CVD(IoBalance$)
  1252.                 assetTotal# = assetTotal# + CVD(IoBalance$)
  1253.                 count1 = count1 + 1
  1254.             END IF
  1255.             CLOSE
  1256.             a = a + 1
  1257.         WEND
  1258.  
  1259.         LOCATE 2, 55: PRINT " LIABILITIES "
  1260.         liabilityTotal# = 0
  1261.         a = 1
  1262.         count2 = 1
  1263.         WHILE a <= maxLiability
  1264.             file$ = "money." + Cvit$(liabilityIndex(a))
  1265.             OPEN file$ FOR RANDOM AS #1 LEN = 84
  1266.             FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$
  1267.             GET #1, 1
  1268.             IF valid$ = "THISISVALID" THEN
  1269.                 LOCATE 2 + count2, 43: PRINT USING u1$; account(liabilityIndex(a)).Title; CVD(IoBalance$)
  1270.                 liabilityTotal# = liabilityTotal# + CVD(IoBalance$)
  1271.                 count2 = count2 + 1
  1272.             END IF
  1273.             CLOSE
  1274.             a = a + 1
  1275.         WEND
  1276.         IF count2 > count1 THEN count1 = count2
  1277.         LOCATE 2 + count1, 25: PRINT "--------------"
  1278.         LOCATE 2 + count1, 65: PRINT "--------------"
  1279.         LOCATE 3 + count1, 3: PRINT USING u2$; "Total assets"; assetTotal#;
  1280.         LOCATE 3 + count1, 43: PRINT USING u2$; "Total liabilities"; liabilityTotal#
  1281.  
  1282.         COLOR colors(5, ColorPref), colors(4, ColorPref)
  1283.         LOCATE 1, 43: PRINT USING u2$; "    NET WORTH:"; assetTotal# - liabilityTotal#
  1284.  
  1285.         DO: Kbd$ = INKEY$: LOOP UNTIL Kbd$ <> ""
  1286.  
  1287.         SELECT CASE Kbd$                            'Handle Special keys
  1288.             CASE CHR$(0) + "<"                      'F2
  1289.                 finished = TRUE
  1290.             CASE CHR$(0) + "="                      'F3
  1291.                GOSUB NetWorthReportPrint
  1292.             CASE ELSE
  1293.                BEEP
  1294.         END SELECT
  1295.     LOOP UNTIL finished
  1296.     EXIT SUB
  1297.  
  1298. NetWorthReportPrint:
  1299.     PrintHelpLine ""
  1300.    
  1301.     Box 8, 20, 14, 62
  1302.     Center 10, "Prepare printer on LPT1 for report"
  1303.     Center 12, "Hit <Enter> to print, or <Esc> to abort"
  1304.  
  1305.     DO: Kbd$ = INKEY$: LOOP WHILE Kbd$ <> CHR$(13) AND Kbd$ <> CHR$(27)
  1306.  
  1307.     IF Kbd$ = CHR$(13) THEN
  1308.         Box 8, 20, 14, 62
  1309.         Center 11, "Printing report..."
  1310.         u0$ = "                     \                  \ "
  1311.         u1$ = "                        \                 \ $$###,###,###.##"
  1312.         u2$ = "                                              --------------"
  1313.         u3$ = "                                               ============="
  1314.         u4$ = "                        \               \+$$#,###,###,###.##"
  1315.         PrintErr = FALSE
  1316.         ON ERROR GOTO ErrorTrap                 ' test if printer is connected
  1317.         LPRINT
  1318.         IF PrintErr = FALSE THEN
  1319.             LPRINT : LPRINT : LPRINT : LPRINT : LPRINT
  1320.             LCenter "Q B a s i c"
  1321.             LCenter "M O N E Y   M A N A G E R"
  1322.             LPRINT : LPRINT
  1323.             LCenter "NET WORTH REPORT:  " + DATE$
  1324.             LCenter "-------------------------------------------"
  1325.             LPRINT USING u0$; "ASSETS:"
  1326.             assetTotal# = 0
  1327.             a = 1
  1328.             WHILE a <= maxAsset
  1329.                 file$ = "money." + Cvit$(assetIndex(a))
  1330.                 OPEN file$ FOR RANDOM AS #1 LEN = 84
  1331.                 FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$
  1332.                 GET #1, 1
  1333.                 IF valid$ = "THISISVALID" THEN
  1334.                     LPRINT USING u1$; account(assetIndex(a)).Title; CVD(IoBalance$)
  1335.                     assetTotal# = assetTotal# + CVD(IoBalance$)
  1336.                 END IF
  1337.                 CLOSE #1
  1338.                 a = a + 1
  1339.             WEND
  1340.             LPRINT u2$
  1341.             LPRINT USING u4$; "Total assets"; assetTotal#
  1342.             LPRINT
  1343.             LPRINT
  1344.             LPRINT USING u0$; "LIABILITIES:"
  1345.             liabilityTotal# = 0
  1346.             a = 1
  1347.             WHILE a <= maxLiability
  1348.                 file$ = "money." + Cvit$(liabilityIndex(a))
  1349.                 OPEN file$ FOR RANDOM AS #1 LEN = 84
  1350.                 FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$
  1351.                 GET #1, 1
  1352.                 IF valid$ = "THISISVALID" THEN
  1353.                     LPRINT USING u1$; account(liabilityIndex(a)).Title; CVD(IoBalance$)
  1354.                     liabilityTotal# = liabilityTotal# + CVD(IoBalance$)
  1355.                 END IF
  1356.                 CLOSE #1
  1357.                 a = a + 1
  1358.             WEND
  1359.             LPRINT u2$
  1360.             LPRINT USING u4$; "Total liabilities"; liabilityTotal#
  1361.             LPRINT
  1362.  
  1363.             LPRINT
  1364.             LPRINT u3$
  1365.             LPRINT USING u4$; "NET WORTH"; assetTotal# - liabilityTotal#
  1366.             LCenter "-------------------------------------------"
  1367.             LPRINT : LPRINT : LPRINT
  1368.         END IF
  1369.         ON ERROR GOTO 0
  1370.     END IF
  1371.     RETURN
  1372. END SUB
  1373.  
  1374. 'PrintHelpLine:
  1375. '  Prints help text on the bottom row in the proper color
  1376. SUB PrintHelpLine (help$)
  1377.     COLOR colors(5, ColorPref), colors(4, ColorPref)
  1378.     LOCATE 25, 1
  1379.     PRINT SPACE$(80);
  1380.     Center 25, help$
  1381. END SUB
  1382.  
  1383. 'SaveState:
  1384. '  Save color preference and account information to "MONEY.DAT" data file.
  1385. SUB SaveState
  1386.     OPEN "money.dat" FOR OUTPUT AS #2
  1387.     PRINT #2, ColorPref
  1388.     
  1389.     FOR a = 1 TO 19
  1390.         PRINT #2, account(a).Title
  1391.         PRINT #2, account(a).AType
  1392.         PRINT #2, account(a).Desc
  1393.     NEXT a
  1394.     
  1395.     CLOSE #2
  1396. END SUB
  1397.  
  1398. 'ScrollDown:
  1399. '  Call the assembly program to scroll the screen down
  1400. SUB ScrollDown
  1401.     DEF SEG = VARSEG(ScrollDownAsm(1))
  1402.     CALL Absolute(VARPTR(ScrollDownAsm(1)))
  1403.     DEF SEG
  1404. END SUB
  1405.  
  1406. 'ScrollUp:
  1407. '  Calls the assembly program to scroll the screen up
  1408. SUB ScrollUp
  1409.     DEF SEG = VARSEG(ScrollUpAsm(1))
  1410.     CALL Absolute(VARPTR(ScrollUpAsm(1)))
  1411.     DEF SEG
  1412. END SUB
  1413.  
  1414. 'SparklePause:
  1415. '  Creates flashing border for intro screen
  1416. SUB SparklePause
  1417.  
  1418.     COLOR 4, 0
  1419.     a$ = "*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    "
  1420.     WHILE INKEY$ <> "": WEND 'Clear keyboard buffer
  1421.  
  1422.     WHILE INKEY$ = ""
  1423.         FOR a = 1 TO 5
  1424.             LOCATE 1, 1                             'print horizontal sparkles
  1425.             PRINT MID$(a$, a, 80);
  1426.             LOCATE 22, 1
  1427.             PRINT MID$(a$, 6 - a, 80);
  1428.  
  1429.             FOR b = 2 TO 21                         'Print Vertical sparkles
  1430.                 c = (a + b) MOD 5
  1431.                 IF c = 1 THEN
  1432.                     LOCATE b, 80
  1433.                     PRINT "*";
  1434.                     LOCATE 23 - b, 1
  1435.                     PRINT "*";
  1436.                 ELSE
  1437.                     LOCATE b, 80
  1438.                     PRINT " ";
  1439.                     LOCATE 23 - b, 1
  1440.                     PRINT " ";
  1441.                 END IF
  1442.             NEXT b
  1443.         NEXT a
  1444.     WEND
  1445. END SUB
  1446.  
  1447. 'TransactionSummary:
  1448. '  Print transaction summary to line printer
  1449. SUB TransactionSummary (item)
  1450.     FancyCls colors(2, ColorPref), colors(1, ColorPref)
  1451.     PrintHelpLine ""
  1452.     Box 8, 20, 14, 62
  1453.     Center 10, "Prepare printer on LPT1 for report"
  1454.     Center 12, "Hit <Enter> to print, or <Esc> to abort"
  1455.  
  1456.     DO: Kbd$ = INKEY$: LOOP WHILE Kbd$ <> CHR$(13) AND Kbd$ <> CHR$(27)
  1457.  
  1458.     IF Kbd$ = CHR$(13) THEN
  1459.         Box 8, 20, 14, 62
  1460.         Center 11, "Printing report..."
  1461.         PrintErr = FALSE
  1462.         ON ERROR GOTO ErrorTrap                 ' test if printer is connected
  1463.         LPRINT
  1464.         IF PrintErr = FALSE THEN
  1465.             PRINT
  1466.             LPRINT : LPRINT : LPRINT : LPRINT : LPRINT
  1467.             LCenter "Q B a s i c"
  1468.             LCenter "M O N E Y   M A N A G E R"
  1469.             LPRINT : LPRINT
  1470.             LCenter "Transaction summary: " + Trim$(account(item).Title)
  1471.             LCenter DATE$
  1472.             LPRINT
  1473.             u5$ = "--------|------|------------------------|----------|----------|--------------"
  1474.             LPRINT u5$
  1475.             LPRINT "  Date  | Ref# | Description            | Increase | Decrease |  Balance   "
  1476.             LPRINT u5$
  1477.              u0$ = "\      \|\    \|\                      \|"
  1478.             u2$ = "###,###.##"
  1479.             u3$ = "###,###,###.##"
  1480.             u4$ = "          "
  1481.  
  1482.             file$ = "money." + Cvit$(item)
  1483.             OPEN file$ FOR RANDOM AS #1 LEN = 84
  1484.             FIELD #1, 8 AS IoDate$, 10 AS IoRef$, 50 AS IoDesc$, 8 AS IoFig1$, 8 AS IoFig2$
  1485.             FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$
  1486.             GET #1, 1
  1487.             IF valid$ = "THISISVALID" THEN
  1488.                 Balance# = 0
  1489.                 MaxRecord = VAL(IoMaxRecord$)
  1490.                 CurrRecord = 1
  1491.                 WHILE CurrRecord <= MaxRecord
  1492.  
  1493.                     GET #1, CurrRecord + 1
  1494.                     Fig1# = CVD(IoFig1$)
  1495.                     Fig2# = CVD(IoFig2$)
  1496.  
  1497.                     LPRINT USING u0$; IoDate$; IoRef$; IoDesc$;
  1498.                     IF Fig2# = 0 AND Fig1# = 0 THEN
  1499.                         LPRINT USING u4$ + "|" + u4$ + "|" + u3$; Balance#
  1500.                     ELSEIF Fig2# = 0 THEN
  1501.                         Balance# = Balance# + Fig1#
  1502.                         LPRINT USING u2$ + "|" + u4$ + "|" + u3$; Fig1#; Balance#
  1503.                     ELSE
  1504.                         Balance# = Balance# - Fig2#
  1505.                         LPRINT USING u4$ + "|" + u2$ + "|" + u3$; Fig2#; Balance#
  1506.                     END IF
  1507.                     CurrRecord = CurrRecord + 1
  1508.                 WEND
  1509.                 LPRINT u5$
  1510.                 LPRINT : LPRINT
  1511.             END IF
  1512.             ON ERROR GOTO 0
  1513.         END IF
  1514.         CLOSE
  1515.     END IF
  1516. END SUB
  1517.  
  1518. 'Trin$:
  1519. '  Remove null and spaces from the end of a string.
  1520. FUNCTION Trim$ (X$)
  1521.  
  1522.     IF X$ = "" THEN
  1523.         Trim$ = ""
  1524.     ELSE
  1525.         lastChar = 0
  1526.         FOR a = 1 TO LEN(X$)
  1527.             y$ = MID$(X$, a, 1)
  1528.             IF y$ <> CHR$(0) AND y$ <> " " THEN
  1529.                 lastChar = a
  1530.             END IF
  1531.         NEXT a
  1532.         Trim$ = LEFT$(X$, lastChar)
  1533.     END IF
  1534.     
  1535. END FUNCTION
  1536.  
  1537.